﻿Imports System.IO
Imports System.Security.Principal

Imports Microsoft.Vbe.Interop

<ComClass(ClsVbaHelper.ClassId, ClsVbaHelper.InterfaceId, ClsVbaHelper.EventsId)>
Public Class ClsVbaHelper

#Region "COM GUID"
    ' 这些 GUID 提供此类的 COM 标识 
    ' 及其 COM 接口。若更改它们，则现有的
    ' 客户端将不再能访问此类。
    Public Const ClassId As String = "0efeb3cc-bd8c-4e3b-8113-18ee2f709e83"
    Public Const InterfaceId As String = "b2cdc21f-ac5b-4a12-9893-03795744bb65"
    Public Const EventsId As String = "bb6f78fc-2a7f-4f2a-8ade-58fd7a437691"
#End Region

    ' 可创建的 COM 类必须具有一个不带参数的 Public Sub New() 
    ' 否则， 将不会在 
    ' COM 注册表中注册此类，且无法通过
    ' CreateObject 创建此类。
    Public Sub New()
        MyBase.New()
    End Sub

    Public Function ArrayIsNull(ByRef arr() As Object) As Boolean
        Return arr.Length = 0
    End Function

    ''' <summary>
    ''' 
    ''' </summary>
    ''' <param name="app">excel 或者 autocad的application对象</param>
    ''' <param name="vbafilefn">vba文件名称</param>
    ''' <param name="codeSavefdName">代码保存的文件夹</param>
    Public Function ExportOutVbaCode(app As Object, Optional vbafilefn As String = "", Optional codeSavefdName As String = "") As String

        Dim VBComponent As Object, Count As Integer, dir As String, extension As String, curVBProject As VBProject
        Dim vbeobj As VBE = app.VBE
        If vbafilefn = "" Then
            curVBProject = vbeobj.ActiveVBProject
        Else
            For Each item As VBProject In vbeobj.VBProjects
                If item.FileName = vbafilefn Then
                    curVBProject = item
                    Exit For
                End If
            Next
        End If

        If curVBProject IsNot Nothing Then
            dir = Path.GetDirectoryName(curVBProject.FileName) & "\" & codeSavefdName
            If Not Directory.Exists(dir) Then Directory.CreateDirectory(dir)

            For Each vbCompo In curVBProject.VBComponents
                Select Case vbCompo.Type
                    Case 2, 100
                        extension = ".cls"
                    Case 3
                        extension = ".frm"
                    Case 1
                        extension = ".bas"
                    Case Else
                        extension = ".txt"
                End Select

                On Error Resume Next

                Err.Clear()

                Dim dirCode = dir & "\" & vbCompo.Name & extension

                Call vbCompo.Export(dirCode)

                If Err.Number <> 0 Then
                    Call MsgBox("Failed to export " & vbCompo.Name & " to " & dirCode, vbCritical)
                Else
                    Count += 1
                    'Debug.Print "Exported " & Left$(VBComponent.Name & ":" & Space(Padding), Padding) & path
                End If
            Next
            Return "Successfully exported " & CStr(Count) & " VBA files to " & dir & "\"
        Else
            Return String.Empty
        End If

    End Function

    ''' <summary>
    ''' 提取方法名称
    ''' </summary>
    ''' <param name="serachTxt"></param>
    ''' <param name="curProjName"></param>
    ''' <returns></returns>
    Public Function GetCurProjectSubNames(serachTxt As String, curProjName As String, app As Object) As String()

        Dim res As New List(Of String)
        Dim VBComponent As Object, basModule As CodeModule, curVBProject As VBProject, vbpro As Object
        '获取当前项目
        For Each vbpro In app.VBE.VBProjects
            If vbpro.Name = curProjName Then
                curVBProject = vbpro
                Exit For
            End If
        Next

        If curVBProject IsNot Nothing Then
            For Each VBComponent In curVBProject.VBComponents

                If VBComponent.Type = 2 Or VBComponent.Type = 100 Then
                    If VBComponent.CodeModule.Name = "ThisDrawing" Or VBComponent.CodeModule.Name = "ThisWorkBook" Then
                        basModule = VBComponent.CodeModule
                    End If
                ElseIf VBComponent.Type = 1 Then
                    basModule = VBComponent.CodeModule
                End If

                If basModule IsNot Nothing Then
                    For i = 1 To basModule.CountOfLines
                        If basModule.ProcOfLine(i, vbext_ProcKind.vbext_pk_Proc) <> "" Then
                            Dim clsName = basModule.Name
                            Dim methodName = basModule.ProcOfLine(i, vbext_ProcKind.vbext_pk_Proc)
                            If Not res.Contains(clsName & "." & methodName) And methodName Like serachTxt & "*" Then
                                res.Add(clsName & "." & methodName)
                            End If
                        End If
                    Next i
                End If
            Next
        End If


        Return res.ToArray()

    End Function

    ''' <summary>
    ''' 
    ''' </summary>
    ''' <param name="hnd"></param>
    ''' <returns></returns>
    Public Function GetEntityByHandle(hnd As String) As String
        GetEntityByHandle = "(Handent " & Chr(34) & hnd & Chr(34) & ")"
        'chr(34)=",chr(32)=space,https://docs.microsoft.com/zh-cn/office/vba/language/reference/user-interface-help/chr-function
        'https://docs.microsoft.com/zh-cn/office/vba/language/reference/user-interface-help/character-set-0127
        Dim arr = {2, 3}

    End Function

    Public Function ArrayMax(arr As Object, ByRef result As Object) As String
        If VarType(arr) = VariantType.Array + VariantType.Double Or VarType(arr) = VariantType.Array + VariantType.Integer Then
            Try
                Dim list As New List(Of Object)
                For index = LBound(arr) To UBound(arr)
                    list.Add(arr(index))
                Next
                result = list.Max()
                Return ""
            Catch ex As Exception
                Return ex.Message
            End Try
        Else
            Return $"参数 {NameOf(arr)} 不是数字数组"
        End If
    End Function

    Public Function ArraySum(arr As Object, ByRef result As Object) As String
        If VarType(arr) = VariantType.Array + VariantType.Double Or VarType(arr) = VariantType.Array + VariantType.Integer Then
            Try
                Dim list As New List(Of Object)
                For index = LBound(arr) To UBound(arr)
                    list.Add(arr(index))
                Next
                result = list.Sum(Function(c) CDbl(c))
                Return ""
            Catch ex As Exception
                Return ex.Message
            End Try
        Else
            Return $"参数 {NameOf(arr)} 不是数字数组"
        End If
    End Function

    Public Function ArrayDistinct(arr As Object, ByRef result As Object) As String
        If VarType(arr) > vbArray Then
            Try
                Dim list As New List(Of Object)
                For index = LBound(arr) To UBound(arr)
                    list.Add(arr(index))
                Next
                result = list.Distinct().ToArray()
                Return ""
            Catch ex As Exception
                Return ex.Message
            End Try
        Else
            Return $"参数 {NameOf(arr)} 不是数组"
        End If
    End Function

    Public Function Array按降序对序列的元素排序(ByRef arr As Object) As String
        If VarType(arr) > vbArray Then
            Try
                Dim list As New List(Of Object)
                For index = LBound(arr) To UBound(arr)
                    list.Add(arr(index))
                Next
                arr = list.OrderByDescending(Function(c) c).ToArray()
                Return ""
            Catch ex As Exception
                Return ex.Message
            End Try
        Else
            Return $"参数 {NameOf(arr)} 不是数组"
        End If
    End Function

    Public Function Array按升序对序列的元素进行排序(ByRef arr As Object) As String
        If VarType(arr) > vbArray Then
            Try
                Dim list As New List(Of Object)
                For index = LBound(arr) To UBound(arr)
                    list.Add(arr(index))
                Next
                arr = list.OrderBy(Function(c) c).ToArray()
                Return ""
            Catch ex As Exception
                Return ex.Message
            End Try
        Else
            Return $"参数 {NameOf(arr)} 不是数组"
        End If
    End Function

    Public Function ArrayJoin(arr As Object, splitor As String, ByRef result As String) As String
        If VarType(arr) > vbArray Then
            Try
                Dim list As New List(Of Object)
                For index = LBound(arr) To UBound(arr)
                    list.Add(arr(index))
                Next
                result = String.Join(splitor, list)
                Return ""
            Catch ex As Exception
                Return ex.Message
            End Try
        Else
            Return $"参数 {NameOf(arr)} 不是数组"
        End If
    End Function

    Public Function ArrayAppend(ByRef arr As Object, ele As Object) As String
        If VarType(arr) > vbArray Then
            Try
                Dim list As New List(Of Object)
                For index = LBound(arr) To UBound(arr)
                    list.Add(arr(index))
                Next
                list.Add(ele)
                arr = list.ToArray()
                Return ""
            Catch ex As Exception
                Return ex.Message
            End Try
        Else
            Return $"参数 {NameOf(arr)} 不是数组"
        End If
    End Function

    Public Function ArrayRemoveAt(ByRef arr As Object, index As Integer) As String
        If VarType(arr) > vbArray Then
            Try
                Dim list As New List(Of Object)
                For i = LBound(arr) To UBound(arr)
                    list.Add(arr(i))
                Next
                list.RemoveAt(index)
                arr = list.ToArray()
                Return ""
            Catch ex As Exception
                Return ex.Message
            End Try
        Else
            Return $"参数 {NameOf(arr)} 不是数组"
        End If
    End Function

    Public Function ArrayInsertAt(ByRef arr As Object, index As Integer, ele As Object) As String
        If VarType(arr) > vbArray Then
            Try
                Dim list As New List(Of Object)
                For i = LBound(arr) To UBound(arr)
                    list.Add(arr(i))
                Next
                list.Insert(index, ele)
                arr = list.ToArray()
                Return ""
            Catch ex As Exception
                Return ex.Message
            End Try
        Else
            Return $"参数 {NameOf(arr)} 不是数组"
        End If
    End Function

    Public Function ArrayContains(ByRef arr As Object, ele As Object, ByRef result As Boolean) As String
        If VarType(arr) > vbArray Then
            Try
                Dim list As New List(Of Object)
                For i = LBound(arr) To UBound(arr)
                    list.Add(arr(i))
                Next
                result = list.Contains(ele)
                Return ""
            Catch ex As Exception
                Return ex.Message
            End Try
        Else
            Return $"参数 {NameOf(arr)} 不是数组"
        End If
    End Function

    Public Function ElementSwap(ByRef ele1 As Object, ByRef ele2 As Object) As String
        'If VarType(ele1) = VarType(ele2) Then
        Try
            Dim temp = ele1
            ele1 = ele2
            ele2 = temp
            Return ""
        Catch ex As Exception
            Return ex.Message
        End Try
        'Else
        '    Return $"参数 {NameOf(ele1)} 和参数 {NameOf(ele1)} 必须相同,或者都不声明具体的数据类形 "
        'End If
        Dim a(1) As Object
    End Function

    Public Function FileInUse(ByVal filename As String) As Boolean
        Dim use As Boolean = True
        Dim fs As FileStream = Nothing
        Try
            fs = New FileStream(filename, FileMode.Open, FileAccess.Read, FileShare.None)
            use = False
        Catch exception1 As Exception
        Finally
            If (Not fs Is Nothing) Then
                fs.Close()
            End If
        End Try
        Return use
    End Function

    Public Function GetSpliterRightText(ByVal str As String, ByVal spliter As String) As String
        Return If(HasSpliter(str, spliter), str.Substring((str.IndexOf(spliter, StringComparison.Ordinal) + 1), ((str.Length - str.IndexOf(spliter, StringComparison.Ordinal)) - 1)), str)
    End Function

    Public Function GetSpliterLeftText(ByVal str As String, ByVal spliter As String) As String
        Return If(HasSpliter(str, spliter), str.Substring(0, str.IndexOf(spliter, StringComparison.Ordinal)), str)
    End Function

    Public Function HasSpliter(ByVal str As String, ByVal spliter As String) As Boolean
        Return str.Contains(spliter)
    End Function

    Public Function ChangeExtension(oriFileName As String, targetExt As String) As String
        Try
            Path.ChangeExtension(oriFileName, targetExt)
            Return String.Empty
        Catch ex As Exception
            Return ex.Message
        End Try
    End Function

    Public Function ActiveAppWindow(processName As String, caption As String) As Boolean
        Dim curPro = Process.GetProcessesByName(processName).First(Function(p) p.MainWindowTitle <> vbEmpty And p.MainWindowTitle = caption)
        If curPro IsNot Nothing Then
            Win32Api.ShowWindowAsync(curPro.MainWindowHandle, Win32Api.SW_MAXIMIZE) '显示
            Win32Api.SetForegroundWindow(curPro.MainWindowHandle) '当到最前端
            Return True
        Else
            Return False
        End If
    End Function
End Class


